(* Index Construction*)

(* The main steps are :

1. Collect the documents to be indexed.
2. Tokenize the text.
3. Do linguistic preprocessing of tokens.
4. Index the documents that each term occurs in.
*)

(*
bugs : 
	Accents are not handled properly by the file reader
	btrees are not balanced !
	*)

	

module type Index_t =
sig
	type token
	type term
	type 'a btree
	val create : unit -> 'a btree
	val get_documents : Unix.dir_handle -> (string*int) list
	val line : in_channel -> string Queue.t
	val tokenization : string -> token
	val stemmer : token -> term
	val insert : (token * int list) btree ref -> token list -> int -> unit
	val tri : ('a * 'b list) btree ref -> unit
	val print : (token * int list) btree -> unit
	
	val index_file : in_channel -> int -> (token*int list) btree ref ->unit
	
	val search : (token * int list) btree -> string -> int list option
	end ;;


module Index  (*: Index_t*)=
struct
	
	type token= string
	type term= string
	type posting_list = int list
	type result = token * posting_list
	type 'a btree = Empty | Leave of 'a | Node of 'a btree array
	(* 'a is the type of the elements, for instance: the term + its posting list + its frequency
	   'b is the type of subtrees labels, typically char*)
	(*Definition of B-trees:
	this definition is not the same as it could be found on wikipedia
	- CONVENTION #1 : each btree has exactly nb_char subtrees or none
	*)
	let create ()=Empty
	
	let nb_char = 27 (*This is the width of the btree*)
	(*Why this number ?
	1-26 are for the 26 letters in alphabet
	0 is for the 'end_of_word' character
	maybe more in the future
	*)
	
	
	
	(*File handling*)

	let get_documents dir=
		let l=ref [] and pattern=Str.regexp ".*txt" and docid=ref 0 in
		try
		while true do
			let file=(Unix.readdir dir) in
			if Str.string_match pattern file 0 then
				(incr docid; l:= (file,!docid)::(!l))
		done; !l
		with _ -> !l
		
	
	let line file =
		let str= input_line file in
		(*Printf.printf "%s\n" str;*)
		let n=String.length str in
		let todo=Queue.create () in
		let word= ref "" in
		for i=0 to n-1 do
			let c=String.get str i in
			(*Printf.printf "%c\n" c;*)
			match c with
				|' ' |','|'!'|'?'|'.' -> ( Queue.push !word todo; word :="")
				| _ -> word := !word ^ (String.make 1 c)
			done;
			( Queue.push !word todo; word :=""); (*to catch the last word if the line doesnt end with a space*)
		(*Queue.iter (Printf.printf "%s\n") todo;*)
		todo
	
	(*Word handling*)

    let rotation s i=
        let n=String.length s in
        assert (i<n); 
        (String.sub s i (n-i)) ^ (String.sub s 0 i)
        
    let rotations s=
        let n=String.length s in
        let res=ref [] in
        for i=0 to n-1 do
            res := (rotation s i):: !res
            done;
        !res
	
	let tokenization (s:string)=
	(*Handles words like O'Neil or aren't and try to do truecapitalisation*)
		let tmp= String.lowercase s in
		(tmp:token)
	

	let stemmer (s:token)=
		(*This part will uses the stemmer coded by another person*)
		(s:term)
	

	let char2posi c=
		match c with
		|'a' -> 1 |'b'->2 |'c'->3 |'d'->4 |'e'->5 |'f'->6 |'g'->7 |'h'->8 |'i'->9 |'j'->10 |'k'->11 |'l'->12 |'m'->13 |'n'->14 |'o'->15 |'p'->16 |'q'->17 |'r'->18 |'s'->19 |'t'->20 |'u'->21 |'v'->22 |'w'->23 |'x'->24 |'y'->25 |'z'->26
		|'$'-> 0 
		| s -> (*failwith (Printf.sprintf "ya un truc a modifier dans char2posi, le caraectere %c nest pas reconnu" s)*) 0
	

        
       
	

	let insert (dict:'a btree ref) (tokens:token list) (docid:int)=
	Printf.printf "entree dans insert\n";flush stdout;
		let rec insertion dict token docidliste depth=
			match dict with
				| Empty -> Leave (token, docidliste)
				| Leave (tok, liste) -> 
					if token=tok 
					then Leave (tok,docid::liste) 
					else begin
						let new_tree = Node (Array.make nb_char Empty) in
						List.fold_left (fun dict (token,post)-> insertion dict token post (depth)) new_tree [(tok,liste);(token,docidliste)]
						end
				| Node stage -> begin
					let m=String.length token in
					(if m=depth (*where do we insere token ?*)
						then stage.(0) <- Leave (token,docidliste) 
						else let j=char2posi (String.get token depth) in stage.(j) <- insertion stage.(j) token docidliste (depth+1));
					Node stage
					end
			in
			dict := List.fold_left (fun dict token-> insertion dict token [docid] 0) !dict tokens
			

			
	(* This is a uninteresting part of code where we define the quick sort with merging without double occurences*)

	let rec rev_append l1 l2 =
	  match l1 with
		[] -> l2
	  | a :: l -> rev_append l (a :: l2)
	 

	let rec chop k l =
	  if k = 0 then l else begin
		match l with
		| x::t -> chop (k-1) t
		| _ -> assert false
	  end
	
	let f liste =
		let rec final liste prev=
			match liste with
			| []->prev::[]
			| t::q -> if prev=t then final q prev else prev::(final q t)
		in
		match liste with |[]->[] | t::q -> final q t 

	let stable_sort cmp l =
	  let rec rev_merge l1 l2 accu =
		match l1, l2 with
		| [], l2 -> rev_append l2 accu
		| l1, [] -> rev_append l1 accu
		| h1::t1, h2::t2 ->
			(match cmp h1 h2 with
		  | (-1) -> rev_merge t1 l2 (h1::accu)
		  | 0 -> rev_merge t1 t2 (h1::accu)
		  | _ -> rev_merge l1 t2 (h2::accu) ) 
	  in
	  let rec rev_merge_rev l1 l2 accu =
		match l1, l2 with
		| [], l2 -> rev_append l2 accu
		| l1, [] -> rev_append l1 accu
		| h1::t1, h2::t2 ->
			if cmp h1 h2 > 0
			then rev_merge_rev t1 l2 (h1::accu)
			else rev_merge_rev l1 t2 (h2::accu)
	  in
	  let rec sort n l =
    match n, l with
    | 2, x1 :: x2 :: _ ->
       if cmp x1 x2 <= 0 then f [x1; x2] else f [x2; x1]
    | 3, x1 :: x2 :: x3 :: _ ->
       if cmp x1 x2 <= 0 then begin
         if cmp x2 x3 <= 0 then f [x1; x2; x3]
         else if cmp x1 x3 <= 0 then f [x1; x3; x2]
         else f [x3; x1; x2]
       end else begin
         if cmp x1 x3 <= 0 then f [x2; x1; x3]
         else if cmp x2 x3 <= 0 then f [x2; x3; x1]
         else f [x3; x2; x1]
       end
    | n, l ->
       let n1 = n asr 1 in
       let n2 = n - n1 in
       let l2 = chop n1 l in
       let s1 = rev_sort n1 l in
       let s2 = rev_sort n2 l2 in
       rev_merge_rev s1 s2 []
  and rev_sort n l =
    match n, l with
    | 2, x1 :: x2 :: _ ->
       if cmp x1 x2 > 0 then f [x1; x2] else f [x2; x1]
    | 3, x1 :: x2 :: x3 :: _ ->
       if cmp x1 x2 > 0 then begin
         if cmp x2 x3 > 0 then f [x1; x2; x3]
         else if cmp x1 x3 > 0 then f [x1; x3; x2]
         else [x3; x1; x2]
       end else begin
         if cmp x1 x3 > 0 then f [x2; x1; x3]
         else if cmp x2 x3 > 0 then f [x2; x3; x1]
         else f [x3; x2; x1]
       end
    | n, l ->
       let n1 = n asr 1 in
       let n2 = n - n1 in
       let l2 = chop n1 l in
       let s1 = sort n1 l in
       let s2 = sort n2 l2 in
       rev_merge s1 s2 []
  in
  let len = List.length l in
  if len < 2 then l else sort len l
	
	
	
	let sort cmp liste= f (stable_sort cmp liste)	

	let tri (dict:'a btree ref)=
	Printf.printf "entree dans tri\n";flush stdout;
	(** This function sorts the posting lists*)
	(*Attention: the sorting removes the duplicate occurences of the same docid, if one wants to preserve the duplicates, you should use the List.sort instead of the sort prrovide by this module*)
		let rec rtri (dict:'a btree) =
			match dict with
				| Empty -> Empty
				| Leave (tok,liste) -> Leave (tok, sort compare liste)
				| Node stage -> (for i=0 to nb_char-1 do stage.(i) <- rtri stage.(i) done; Node stage)
			in
		dict :=rtri !dict
	


	let print (dict:'a btree) =
		let rec rprint dict dec=
			match dict with
			|Empty ->(*print_newline ()*) ()
			|Leave (tok,liste) -> (Printf.printf "%s|->%s " (String.make dec ' ') (tok:token);List.iter (Printf.printf "%i ") liste;print_newline ())
			|Node stage -> (for i=0 to nb_char-1 do rprint stage.(i) (dec+3) done)
		in
		Printf.printf "Affichage d'un dico entier attention\n";
		rprint dict 0
		
		
	let index_file  file docid dict=
	Printf.printf "entree dans lindexatation\n";flush stdout;
		try 
		while true do
		insert dict (Queue.fold (fun liste s->(rotations ((tokenization s)^ "$")) @ liste) [] (line file)) docid;
		tri dict
		done;
		with
		End_of_file -> ()
	
	let rec dict2list dict = 
		match dict with
			|Empty ->[]
			|Leave x -> [x]
			|Node stage -> Array.fold_left (fun acc subtree -> dict2list subtree @ acc)  [] stage
			
	
	let search (dict:(token* int list) btree) (s:string) :result list=
	    let rec rsearch (dict:'a btree) (s:token) depth=
	        match dict with
	            |Empty -> Empty
	            |Leave (token,post_list) -> if s=token then dict else Empty
	            |Node stage ->let m=String.length s in
					(if m=depth 
						then dict 
						else let j=char2posi (String.get s depth) in rsearch stage.(j) s (depth+1))
	        in
        dict2list (rsearch dict (tokenization s) 0)
        
        
	(*End of the Module*)    
	end;;
	

	let dir=Unix.opendir (Unix.getcwd ());;
	Printf.printf "nous sommes dans %s\n" (Unix.getcwd ());;
	let docs = Index.get_documents dir;;
	List.iter (fun (name,docid) ->Printf.printf "%i : %s\n" docid name) (docs);;	


let dict = ref (Index.create (): (Index.token*int list) Index.btree);;
Printf.printf "\n debut\n";;
List.iter (fun (name,docid) ->Index.index_file (open_in name) docid dict) docs;;
Index.print !dict;;
